home *** CD-ROM | disk | FTP | other *** search
/ Aminet 19 / Aminet 19 (1997)(GTI - Schatztruhe)[!][Jun 1997].iso / Aminet / comm / cnet / portstatus.lha / PORTStatus.rexx < prev    next >
OS/2 REXX Batch file  |  1997-03-19  |  13KB  |  180 lines
  1. /**************************************************************************\
  2.          $VER: Port Status, v6.9c (19-Mar-97) by Star Gazer!
  3.  
  4.    Star Streams BBS    (972) 938-7115   FIDO  1:124/6517    PostCard Ware!
  5. \**************************************************************************/
  6. options results;signal on SYNTAX;signal on ERROR;signal on IOERR;BBSIDENTIFY NAME;SYS=result;BBSIDENTIFY SYSOP;NAM=result;se=sendstring;gc=getchar;qu=query
  7. tr=transmit;gu=getuser;gu 23;cp=result;port=cp;gu 1;handle=result;gu 46;tday=result;gu 57;lt=result;gu 11;lc=result;gu 95;cn=result;gu 7;tl=result;gu 12;ct=result;ver=6.9c
  8. gu 22;tc=result;gu 1500416;fc=result;gu 1200536;cty=result;gu 1200680;tcd=result;ucl=tcd-cty;if ucl<0 then ucl='caUNLIMITED';getuser 1100454;oldmore=result;changewhere'PORTStatus 'ver;oldwh=result
  9. gu 1100661;conf=BittST(d2c(result,4),7)
  10. bbsidentify bbs ; cnet4=(datatype(left(word(result,3),4),"n")=1)
  11. pw='password' /* Password to enter Remote Editing */
  12. xa=1  /* Show SysOp Status?     (0=NO/1=YES) */
  13. xb=1  /* Show NEW USER Status?  (0=NO/1=YES) */
  14. xc=1  /* Show File Area Status? (0=NO/1=YES) */
  15. xd=1  /* Show Game Area Status? (0=NO/1=YES) */
  16. xe=1  /* Show Base Area Status? (0=NO/1=YES) */
  17. xf=3  /* Who has access to SysOp Menu? 0, 1, 2, 3 */
  18. xg=0  /* User option to view port information 0=Force View/1=User Picks */
  19. loadscratch 1;getscratch 15;maintAC=result;savescratch (-1)
  20. if xf=0 then do;maint=0;end
  21. if xf=1 then do;getuser 15;access=result;maint=(access>=maintAC);end
  22. if xf=2 then do;getuser 15;access=result;getuser 40;id=result;maint=(access>=maintAC|id=1);end
  23. if xf=3 then do;getuser 15;access=result;getuser 40;id=result;getuser 1100663;sysop=bittst(result,4);maint=(access>=maintAC|id=1|sysop=1);end
  24. if cnet4=1 then do;xh=1;end;else do;xh=0;end
  25. if xh=0 then do;CNETA=2121864;CNETB=2121862;end;else do;CNETA=2124552;CNETB=2124550;end
  26. if xg=1 then do;tr;se 'ceView your port status? cc[caYcfescf/c9ncfocc] cd> ';gc;vyn=upper(result)
  27. if vyn='N' then do;tr 'c9Now1';tr;tr 'ceThank You for using cfPORTc9Status cb'ver;setobject oldmore;putuser 1100454;changewhere oldwh;exit;end;else tr 'cfYesw1';end
  28. MAIN:;call MOREOFF
  29. tr 'f1c2-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-'
  30. tr 'HcfPORTc9Status cbV'ver;tr ' cfGood 'tday',ce' handle'cf. Thank You for calling ce'sys' cfBBS.'
  31. tr 'c2-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-'
  32. tr 'cfYour call has been answered by ccPort #'cp' cfon ce'lt'.'
  33. tr 'cfYour first call to ce'sys' cfwas on ce'fc'.'
  34. call CNUM(cn);tr 'cfYour last call was on ce'lc'cf. You are caller cb#'a'.'
  35. tr 'cfIt is now ce'ct' cfwith ceL70 7}XR 1}V71}.V70} cfminutes left this call.'
  36. call CNUM(tc);tr 'cfYou have made c9'a' cfcalls with c9'cty' cfmade today and have c9'ucl' cfleft.'
  37. tr 'c2-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-'
  38. if xa=1 then do;call CHECK;if xh=1 then do;gu CNETA+port*24;CanChat=BitTST(d2c(result),4);end;else do;gu CNETA+port*24;CanChat=BitTST(d2c(result),0);end
  39. if CanChat=0 then SS='c9NOT AVAILABLE cffor Chat.';if CanChat=1 then SS='caAVAILABLE cffor Chat.'
  40. tr 'cfThe SysOp cc(ce'NAM'cc) cfis 'SS;end
  41. if xb=1 then do;call CHECK;if xh=1 then do;gu CNETA+port*24;NewUser=BitTST(d2c(result),3);end;else do;gu CNETA+port*24;NewUser=BitTST(d2c(result),1);end
  42. if NewUser=1 then NU='c9NOT Accepting cfNew Users';if NewUser=0 then NU='caAccepting cfNew Users'
  43. tr 'ce'SYS' cfBBS is 'NU' on this port.';tr;end
  44. if xc=1 then do;call CHECK;if xh=1 then do;gu CNETA+port*24;UDBaseS=BitTST(d2c(result),1);end;else do;gu CNETA+port*24;UDBaseS=BitTST(d2c(result),2);end
  45. if UDBaseS=0 then UD='caOPEN';if UDBaseS=1 then UD='c9CLOSED'
  46. se 'cfThe File Area iscb: 'UD'cf, ';end
  47. if xd=1 then do;call CHECK;if xh=1 then do;gu CNETA+port*24;PFilesS=BitTST(d2c(result),0);end;else do;gu CNETA+port*24;PFilesS=BitTST(d2c(result),3);end
  48. if PFilesS=0 then PF='caOPEN';if PFilesS=1 then PF='c9CLOSED'
  49. se 'cfThe Game Area iscb: 'PF'cf, ';end
  50. if xe=1 then do;call CHECK;if xh=1 then do;gu CNETA+port*24;MsgBase=BitTST(d2c(result),2);end;else do;gu CNETA+port*24;MsgBase=BitTST(d2c(result),4);end
  51. if MsgBase=0 then MB='caOPEN';if MsgBase=1 then MB='c9CLOSED'
  52. se 'cfThe Base Area iscb: 'MB;tr;end;if maint=1 then do;tr;call SYSMEN;end
  53. tr;tr;se 'cfPress cc[ceAny Keycc] cfto Continue...g1';setobject oldmore;putuser 1100454;tr ' ceThank You for using cfPORTc9Status cb'ver;setobject oldmore;putuser 1100454;changewhere oldwh;exit
  54. SYSMEN:tr 'cePort    cfPort Status     ceSysOp Around?   cfNewUsers  ceFileArea  cfGameArea  ceBaseArea'
  55. tr 'cc=============================================================================='
  56. it.i=100;gu CNETB+it.i*24;load=result;if load<1 then ld='Closed';else ld='Loaded/'
  57. getportid it.i;tpt=result;if tpt=-1 then do;ld1=ld'Idle12345';end;if ld='Closed' then ld1='Closed Port'
  58. if it.i<100 then do;getportid it.i;id=result;if id>-1 then do;loadscratch id;savescratch (-id);getscratch 1;handle.it=result;ld1=handle.it;end;end
  59. maygetchar;die=upper(result);if die~="NOCHAR" then do;prompt 1 YESNO "cdContinue listing cc[caYcfescc/c9ncfocc] ";CMD=upper(result);if CMD="###PANIC" then exit;if CMD~='YES' then call MAIN
  60. if xa=1 then do;call CHECK;if xh=1 then do;gu CNETA+it.i*24;CanChat=BitTST(d2c(result),4);end;else do;gu CNETA+it.i*24;CanChat=BitTST(d2c(result),0);end;end;end
  61. if CanChat=0 then SS='Not Available';else SS='Available'
  62. call CHECK;if xh=1 then do;gu CNETA+it.i*24;NewUser=BitTST(d2c(result),3);end;else do;gu CNETA+it.i*24;NewUser=BitTST(d2c(result),1);end
  63. if NewUser=1 then NU='No ';else NU='Yes'
  64. call CHECK;if xh=1 then do;gu CNETA+it.i*24;UDBaseS=BitTST(d2c(result),1);end;else do;gu CNETA+it.i*24;NewUser=BitTST(d2c(result),2);end
  65. if UDBaseS=0 then UD='Yes';else UD='No '
  66. call CHECK;if xh=1 then do;gu CNETA+it.i*24;PFilesS=BitTST(d2c(result),0);end;else do;gu CNETA+it.i*24;NewUser=BitTST(d2c(result),3);end
  67. if PFilesS=0 then PF='Yes';else PF='No '
  68. call CHECK;if xh=1 then do;gu CNETA+it.i*24;MsgBase=BitTST(d2c(result),2);end;else do;gu CNETA+it.i*24;NewUser=BitTST(d2c(result),4);end
  69. if MsgBase=0 then MB='Yes';else MB='No '
  70. if it.i=100 then ld1='GLOBAL INFO'
  71. se 'Ccf'left(it.i,6);se left('Cce'ld1,18);se 'Ccf'left(SS,13);se 'Cce'NU;se 'Ccf'UD;se 'Cce'PF;se 'Ccf'MB;tr
  72. tr 'cc=============================================================================='
  73. call NOMORE;tr 'cfSysOp Menuca: cf[cbAny c9KEY cbto cfPAUSE/ABORT cblisting in progresscf] ceEnter cfto Exit.';qu 'cfEnter Range c9cc(cbExamplecf:cd -2 19- 4 7-9 11.13.15,17cc)cf: c9';tot=result;if tot=PW then call edit;tot=PARSE(result,0,100,'s')
  74. if tot=0 then do;tr;tr 'ceThank You for using cfPORTc9Status cb'ver;setobject oldmore;putuser 1100454;changewhere oldwh;exit;end
  75. tr;se 'cfSkip UnLoaded Ports cc(cf[caYescf]ce/c9ncc)cf: ';gc;skip=result;call CHECK;if skip='N' then do;tr 'c9No';end;else tr 'caYes'
  76. tr;tr 'cePort    cfPort Status     ceSysOp Around?   cfNewUsers  ceFileArea  cfGameArea  ceBaseArea'
  77. tr 'cc=============================================================================='
  78. do i=1 to tot;gu CNETB+it.i*24;load=result;if skip~='N'&load<1 then iterate;if load<1 then ld='Closed';else ld='Loaded/'
  79. getportid it.i;tpt=result;if tpt=-1 then do;ld1=ld'Idle12345';end;if ld='Closed' then ld1='Closed Port'
  80. if it.i<100 then do;getportid it.i;id=result;if id>-1 then do;loadscratch id;savescratch (-id);getscratch 1;handle.it=result;ld1=handle.it;end;end
  81. maygetchar;die=upper(result);if die~="NOCHAR" then do;prompt 1 YESNO "cdContinue listing cc[caYcfescc/c9ncfocc] ";CMD=upper(result);if CMD="###PANIC" then exit;if CMD~='YES' then call MAIN;end
  82. if xa=1&xh=1 then do;gu CNETA+it.i*24;CanChat=BitTST(d2c(result),4);end
  83. if xa=1&xh=0 then do;gu CNETA+it.i*24;CanChat=BitTST(d2c(result),0);end
  84. if CanChat=0 then SS='Not Available';else SS='Available'
  85. call CHECK;if xh=1 then do;gu CNETA+it.i*24;NewUser=BitTST(d2c(result),3);end;else do;gu CNETA+it.i*24;NewUser=BitTST(d2c(result),1);end
  86. if NewUser=1 then NU='No ';else NU='Yes'
  87. call CHECK;if xh=1 then do;gu CNETA+it.i*24;UDBaseS=BitTST(d2c(result),1);end;else do;gu CNETA+it.i*24;UDBaseS=BitTST(d2c(result),2);end
  88. if UDBaseS=0 then UD='Yes';else UD='No '
  89. call CHECK;if xh=1 then do;gu CNETA+it.i*24;PFilesS=BitTST(d2c(result),0);end;else do;gu CNETA+it.i*24;PFilesS=BitTST(d2c(result),3);end
  90. if PFilesS=0 then PF='Yes';else PF='No '
  91. call CHECK;if xh=1 then do;gu CNETA+it.i*24;MsgBase=BitTST(d2c(result),2);end;else do;gu CNETA+it.i*24;MsgBase=BitTST(d2c(result),4);end
  92. if MsgBase=0 then MB='Yes';else MB='No '
  93. if it.i=100 then ld1='GLOBAL INFO'
  94. se 'Ccf'left(it.i,6);se left('Cce'ld1,18);se 'Ccf'left(SS,13);se 'Cce'NU;se 'Ccf'UD;se 'Cce'PF;se 'Ccf'MB;tr '';end i
  95. tr 'cc==============================================================================';tr 'cfPress cc[ceAny Keycc] cfto Continue...g1';call MAIN
  96. NOMORE:;sendstring 'L1100454 #0}';return
  97. EDIT:
  98. tr 'f1                         ceÚ´ SysOp Port Editor Ã¿'
  99. tr '                         ce³                     ³'
  100. tr '                         ce³   cfOpen/Close cbPcfort   ce³'
  101. tr '                         ce³   cfOpen/Close cbBcfase   ce³'
  102. tr '                         ce³   cfOpen/Close cbDcfoor   ce³'
  103. tr '                         ce³   cfOpen/Close cbFcfile   ce³'
  104. tr '                         ce³   cfOpen/Close cbMcfesg   ce³'
  105. tr '                         ce³   cfNew/No New cbUcfser   ce³'
  106. tr '                         ce³   cbScfysOp is In/Out   ce³'
  107. tr '                         ce³   cbRcfeturn to Main!   ce³'
  108. tr '                         ce³                     ³'
  109. tr '                         ceÀ´ cfPORTc9Status Editor ceÃÙ'
  110. tr ''
  111. se '17HcfPlease Select Edit Option ce(cbESC TO Exitce)ca:cf';gc;menu=result
  112. if index("PBDFMUSR",MENU)=0 & C2D(menu)~=27 THEN DO
  113.     tr;tr '17HcfPlease pick an option from the listings shownw2';signal EDIT;end
  114. if menu='P' then do;tr menu'w1';call PS1;end
  115. if menu='B' then do;tr menu'w1';call PS2;end
  116. if menu='D' then do;tr menu'w1';call PS3;end
  117. if menu='F' then do;tr menu'w1';call PS4;end
  118. if menu='M' then do;tr menu'w1';call PS5;end
  119. if menu='U' then do;tr menu'w1';call PS6;end
  120. if menu='S' then do;tr menu'w1';call PS7;end
  121. if menu='R' then call MAIN
  122. tr ''
  123. if C2D(menu)=27 then exit
  124. end
  125. call main
  126.  
  127. PS1:
  128. tr '                Not Functional at this time, sorry... :(w2'
  129. call EDIT
  130.  
  131. PS2:
  132. tr '                Not Functional at this time, sorry... :(w2'
  133. call EDIT
  134.  
  135. PS3:
  136. tr '                Not Functional at this time, sorry... :(w2'
  137. call EDIT
  138.  
  139. PS4:
  140. tr '                Not Functional at this time, sorry... :(w2'
  141. call EDIT
  142.  
  143. PS5:
  144. tr '                Not Functional at this time, sorry... :(w2'
  145. call EDIT
  146.  
  147. PS6:
  148. tr '                Not Functional at this time, sorry... :(w2'
  149. call EDIT
  150.  
  151. PS7:
  152. tr '                Not Functional at this time, sorry... :(w2'
  153. call EDIT
  154.  
  155. MOREOFF:;setobject 0;putuser 1100454;return
  156. PARSE: procedure expose it.; arg rng,min,max,srt
  157.    it.='';c=0;it=translate(rng,'  ','.,')
  158.     do a=1 to words(it);c=c+1;it.c=word(it,a)
  159.         if index(it.c,'-')>0 then do;parse var it.c x'-'y
  160.         if y='' then y=max;if x='' then x=min
  161.         if x>y then do;d=x;x=y;y=d;end
  162.         if x<min|y>max|~datatype(x,'W')|~datatype(y,'W') then do;c=c-1;iterate;end
  163.         do b=x to y;it.c=b;c=c+1;end;c=c-1;end
  164.     else if it.c<min|it.c>max|~datatype(it.c,'W') then do;c=c-1;iterate;end;end
  165.     do i=1 to c;it.0=it.0||it.i' ';end
  166.   return c
  167. CNUM: /* Comma Number Parser (Place commas inside numbers) */
  168.     parse arg a;b=length(a);if b=4 then a=insert(',',a,1,1)
  169.     if b=5 then a=insert(',',a,2,1);if b=6 then a=insert(',',a,3,1)
  170.     if b=7 then do;a=insert(',',a,1,1);a=insert(',',a,5,1);end
  171.   return
  172. CHECK:;if result~='###PANIC' then return
  173. tr 'f1n9ccPORTStatusn2c9Loss of Carrier!'
  174. logentry 'No Carrier in PORTStatus!';bufferflush;setobject oldmore;putuser 1100454;changewhere oldwh;exit
  175. SYNTAX:;ERROR:;IOERR:;e1=' Error: 'rc' ('errortext(rc)')';e2='  Line: 'left(sigl,4)'File:'
  176.     getuser 1311992;a=result;getuser 1311960;b=result;c='"'a||b'"';e2=e2' 'c;tr e1;tr e2;logentry e1;logentry e2
  177.     e=sourceline(sigl);do while e~='';e3='Source: 'left(e,37);tr e3;logentry e3;e=substr(e,38);end;bufferflush;setobject oldmore;putuser 1100454;changewhere oldwh;exit
  178. /** Last Edited: 19-Mar-97 ************************************************\
  179. \*************************************** STAR STREAMS BBS (972)/938-7115 **/
  180.